Code (Week 9)

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs, StandaloneDeriving #-}


module ExistsEx where

data M where
  MC :: a -> M


-- we can create values of type M. As the content type
xs :: [M]
xs = [ MC 4, MC True, MC even]

-- we can never do anything with values of type M, as we 
-- can't 'unpack' them. The following function raises a type
-- error, as the type of x can't be known statically
-- unpack (MC x) = x


data MS where
  MSC :: Show a => a -> MS

deriving instance (Show MS)
-- note that the function 'even' can't be in the list now,
-- because it's type is not in the class Show
ys :: [MS]
ys = [ MSC 4, MSC True]

-- we still can't define unpack, but we can take x and apply 
-- show to it: now, it's clear what the result type of the 
-- function is, independent of the actual type of x
unpackAndShow :: MS -> String
unpackAndShow (MSC x) = show x

-- we can also bundle the value of type 'a' explicitly with a 
-- function which knows what to do with it
data MP where
  MPC :: a -> (a -> String) -> MP

-- For the values whose type is in the Show class, we just provide the 
-- their show function, for 'even' we provide a costumised
zs :: [MP]
zs = [ MPC 4    show , 
       MPC True show, 
       MPC even (\_ -> "the function \'even\'")]

unpackAndShowMP :: MP -> String
unpackAndShowMP (MPC x f) = f x

module Shapes where

class ShapeC a where
   perimeter :: a -> Double
   area      :: a -> Double

data Shape = forall a. ShapeC a => Shape a


data Circle    = Circle    Double
data Rectangle = Rectangle Double Double

-- add this instance so we can apply methods directly
instance ShapeC Shape where
  perimeter (Shape shape) = perimeter shape
  area      (Shape shape) = area      shape

-- additional instances can be defined anywhere 
instance ShapeC Circle where
  perimeter (Circle r) = 2 * pi * r
  area      (Circle r) = pi * r * r

instance ShapeC Rectangle where
  perimeter (Rectangle x y) = 2*(x + y)
  area      (Rectangle x y) = x * y




 -- smart constructors

circle :: Double -> Shape
circle r 
  | r > 0     =  Shape (Circle r)
  | otherwise = error "Circle with non-positive radius" 

rectangle :: Double -> Double -> Shape
rectangle x y 
  | x > 0 && y > 0 = Shape (Rectangle x y)
  | otherwise      = error "Rectangle with non-positive side length"

shapes :: [Shape]
shapes = [circle 12, circle 10, rectangle 5 6]